VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsWad"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Public pCnt As Integer
Public pStrt As Integer
Public pEnd As Integer
Public WadType As String
Public WadLumpCount As Long
Public WadDirStart As Long
Public Canvas As Object
Private LumpColl As New Collection
Public LumpDirectory As New clsLumpDir
Public Property Get ReturnLump(ByVal Index As Long) As clsLumpClass
    Set ReturnLump = LumpColl(Index)
End Property

Public Sub Load(FileName As String)
    Dim m_lngLoop As Long
    Dim wHdr As DoomHeader, LumpEntries() As LumpEntry, cLmpByts() As Byte
    Open FileName For Binary As #1
        Get #1, , wHdr
        If Not (wHdr.ASCIIType = "PWAD" Or wHdr.ASCIIType = "IWAD") Then
            MsgBox "Invalid File Header", vbCritical, "Read Error..."
            Close #1
            Exit Sub
        End If
        If wHdr.LumpCount = 0 Then _
            Close #1: GoTo Finished:
        ReDim LumpEntries(1 To wHdr.LumpCount)
        Get #1, wHdr.DirectoryStart + 1, LumpEntries
        For m_lngLoop = 1 To UBound(LumpEntries)
            If Not LumpEntries(m_lngLoop).Length = 0 Then
                ReDim cLmpByts(1 To LumpEntries(m_lngLoop).Length)
            End If
            Get #1, LumpEntries(m_lngLoop).Offset + 1, cLmpByts
            AddLump cLmpByts, LumpEntries(m_lngLoop).Name, LumpEntries(m_lngLoop).Offset, LumpEntries(m_lngLoop).Length
            LumpDirectory.AddEntry LumpEntries(m_lngLoop).Name, LumpEntries(m_lngLoop).Length, LumpEntries(m_lngLoop).Offset
        Next
    Close #1
Finished:
    WadLumpCount = wHdr.LumpCount
    WadType = wHdr.ASCIIType
    WadDirStart = wHdr.DirectoryStart
    For m_lngLoop = 1 To Count
        If LCase(ReturnLump(m_lngLoop).LumpName) = "s_start" & Chr(0) Or LCase(ReturnLump(m_lngLoop).LumpName) = "ss_start" Then
            pStrt = m_lngLoop
        ElseIf (LCase(ReturnLump(m_lngLoop).LumpName) = "s_end" & String(3, Chr(0)) Or LCase(ReturnLump(m_lngLoop).LumpName) = "ss_end" & String(2, Chr(0))) And pStrt > 0 Then
            pCnt = (m_lngLoop - pStrt - 1)
            pEnd = m_lngLoop
        ElseIf pStrt > 0 And pEnd = 0 Then
            ReturnLump(m_lngLoop).LumpType = Sprite
        ElseIf LCase(ReturnLump(m_lngLoop).LumpName) = "things" & Chr(0) & Chr(0) Then
            ReturnLump(m_lngLoop).LumpType = ThingsEntry
        ElseIf LCase(ReturnLump(m_lngLoop).LumpName) = "segs" & String(4, Chr(0)) Then
            ReturnLump(m_lngLoop).LumpType = SEGSEntry
        ElseIf LCase(ReturnLump(m_lngLoop).LumpName) = "vertexes" Then
            ReturnLump(m_lngLoop).LumpType = VertexesEntry
        ElseIf LCase(ReturnLump(m_lngLoop).LumpName) = "sidedefs" Then
            ReturnLump(m_lngLoop).LumpType = SideDefsEntry
        ElseIf Mid(LCase(ReturnLump(m_lngLoop).LumpName), 1, 1) = "e" And Mid(LCase(ReturnLump(m_lngLoop).LumpName), 3, 1) = "m" Then
            ReturnLump(m_lngLoop).LumpType = Doom1Level
        ElseIf Mid(LCase(ReturnLump(m_lngLoop).LumpName), 1, 3) = "map" Then
            ReturnLump(m_lngLoop).LumpType = Doom2Level
        ElseIf Mid(LCase(ReturnLump(m_lngLoop).LumpName), 1, 2) = "m_" Then
            ReturnLump(m_lngLoop).LumpType = MessageEntry
        End If
    Next
    ReCalc
    LumpDirectory.ReCalc
End Sub

Public Sub DeleteLump(ByVal Index As Long)
    LumpColl.Remove Index
    LumpDirectory.RemoveEntry Index
End Sub

Public Sub AddLump(LumpBytes() As Byte, LumpName As String, LumpPosition As Long, LumpLength As Long)
    Dim nLmp As New clsLumpClass
    Static LastLump As clsLumpClass
    nLmp.SetBytes LumpBytes
    nLmp.LumpName = LumpName
    nLmp.LumpPosition = LumpPosition
    nLmp.LumpSize = LumpLength
    If LumpLength = 0 Then LumpPosition = 0
    If (LastLump Is Nothing And nLmp.LumpSize <> 0) Then
        nLmp.LumpPosition = 12
    End If
    If LumpLength = 0 Then
        nLmp.LumpType = Label
    Else
        nLmp.LumpType = MiscEntry
    End If
    LumpColl.Add nLmp
    If WadDirStart = 0 Then WadDirStart = 12
    If Not nLmp.LumpPosition + nLmp.LumpSize = 0 Then
        WadDirStart = nLmp.LumpPosition + nLmp.LumpSize
    End If
    Set LastLump = nLmp
End Sub

Public Property Get Count() As Long
Count = LumpColl.Count
End Property
Public Sub Save(FileName As String)
On Error Resume Next
Kill FileName
On Error GoTo 0
Dim wHdr As DoomHeader, LumpEntries() As LumpEntry, cLmpByts() As Byte, m_lngLoop As Long
Close
If Count > 0 Then ReDim LumpEntries(1 To Count)
WadLumpCount = Count
wHdr.ASCIIType = WadType
wHdr.DirectoryStart = WadDirStart
wHdr.LumpCount = WadLumpCount
    Open FileName For Binary As #1
        Put #1, , wHdr
        For m_lngLoop = 1 To Count
            ReturnLump(m_lngLoop).LumpBytes cLmpByts
            If LumpDirectory(m_lngLoop).LumpSize > 0 And LumpDirectory(m_lngLoop).LumpPosition > 0 Then
            Put #1, LumpDirectory(m_lngLoop).LumpPosition + 1, cLmpByts
            End If
            LumpEntries(m_lngLoop).Length = LumpDirectory(m_lngLoop).LumpSize
            LumpEntries(m_lngLoop).Name = LumpDirectory(m_lngLoop).LumpName & String(8, Chr(0))
            LumpEntries(m_lngLoop).Offset = LumpDirectory(m_lngLoop).LumpPosition
            If LumpEntries(m_lngLoop).Length = 0 Then LumpEntries(m_lngLoop).Offset = 0
        Next
        If Count > 0 Then
            Put #1, WadDirStart + 1, LumpEntries
        End If
    Close #1
End Sub

Public Sub ReCalc()
    Dim DirStart As Long, PlacementStart As Long, m_lngLoop As Long
    DirStart = 12
    PlacementStart = 12
    For m_lngLoop = 1 To Count
        DirStart = DirStart + ReturnLump(m_lngLoop).LumpSize
        If ReturnLump(m_lngLoop).LumpSize > 0 Then
            ReturnLump(m_lngLoop).LumpPosition = PlacementStart
        Else
            ReturnLump(m_lngLoop).LumpPosition = 0
        End If
        PlacementStart = PlacementStart + ReturnLump(m_lngLoop).LumpSize
    Next
    WadDirStart = DirStart
End Sub
